home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / gnu / emacs / emacs1857 / bin_d2.zoo / lisp / terminal.el < prev    next >
Lisp/Scheme  |  1991-12-02  |  39KB  |  1,145 lines
  1. ;; Terminal emulator for GNU Emacs.
  2. ;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
  3. ;; Written by Richard Mlynarik, November 1986.
  4.  
  5. ;; This file is part of GNU Emacs.
  6.  
  7. ;; GNU Emacs is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 1, or (at your option)
  10. ;; any later version.
  11.  
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16.  
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  19. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21. ;;>>TODO
  22. ;;>> terminfo?
  23. ;;>> ** Nothing can be done about emacs' meta-lossage **
  24. ;;>>  (without redoing keymaps `sanely' -- ask Mly for details)
  25.  
  26. ;;>> One probably wants to do setenv MORE -c when running with
  27. ;;>>   more-processing enabled.
  28.  
  29. (provide 'terminal)
  30. (require 'ehelp)
  31.  
  32. (defvar terminal-escape-char ?\C-^
  33.   "*All characters except for this are passed verbatim through the
  34. terminal-emulator.  This character acts as a prefix for commands
  35. to the emulator program itself.  Type this character twice to send
  36. it through the emulator.  Type ? after typing it for a list of
  37. possible commands.
  38. This variable is local to each terminal-emulator buffer.")
  39.  
  40. (defvar terminal-scrolling t
  41.   "*If non-nil, the terminal-emulator will `scroll' when output occurs
  42. past the bottom of the screen.  If nil, output will `wrap' to the top
  43. of the screen.
  44. This variable is local to each terminal-emulator buffer.")
  45.  
  46. (defvar terminal-more-processing t
  47.   "*If non-nil, do more-processing.
  48. This variable is local to each terminal-emulator buffer.")
  49.  
  50. ;; If you are the sort of loser who uses scrolling without more breaks
  51. ;; and expects to actually see anything, you should probably set this to
  52. ;; around 400
  53. (defvar terminal-redisplay-interval 5000
  54.   "*Maximum number of characters which will be processed by the
  55. terminal-emulator before a screen redisplay is forced.
  56. Set this to a large value for greater throughput,
  57. set it smaller for more frequent updates but overall slower
  58. performance.")
  59.  
  60. (defvar terminal-more-break-insertion
  61.   "*** More break -- Press space to continue ***")
  62.  
  63. (defvar terminal-escape-map nil)
  64. (defvar terminal-map nil)
  65. (defvar terminal-more-break-map nil)
  66. (if terminal-map
  67.     nil
  68.   (let ((map (make-keymap)))
  69.     (fillarray map 'te-pass-through)
  70.     ;(define-key map "\C-l"
  71.     ;  '(lambda () (interactive) (te-pass-through) (redraw-display)))
  72.     (setq terminal-map map)))
  73.  
  74. ;(setq terminal-escape-map nil)
  75. (if terminal-escape-map
  76.     nil
  77.   (let ((map (make-keymap)))
  78.     ;(fillarray map 'te-escape-extended-command-unread)
  79.     (fillarray map 'undefined)
  80.     (let ((s "0"))
  81.       (while (<= (aref s 0) ?9)
  82.     (define-key map s 'digit-argument)
  83.     (aset s 0 (1+ (aref s 0)))))
  84.     (define-key map "b" 'switch-to-buffer)
  85.     (define-key map "o" 'other-window)
  86.     (define-key map "e" 'te-set-escape-char)
  87.     (define-key map "\C-l" 'redraw-display)
  88.     (define-key map "\C-o" 'te-flush-pending-output)
  89.     (define-key map "m" 'te-toggle-more-processing)
  90.     (define-key map "x" 'te-escape-extended-command)
  91.     (define-key map "?" 'te-escape-help)
  92.     (define-key map (char-to-string help-char) 'te-escape-help)
  93.     (setq terminal-escape-map map)))
  94.  
  95. (defvar te-escape-command-alist ())
  96. ;(setq te-escape-command-alist ())
  97. (if te-escape-command-alist
  98.     nil
  99.   (setq te-escape-command-alist
  100.     '(("Set Escape Character" . te-set-escape-char)
  101.       ("Refresh" . redraw-display)
  102.       ("Record Output" . te-set-output-log)
  103.       ("Photo" . te-set-output-log)
  104.       ("Tofu" . te-tofu) ;; confuse the uninitiated
  105.       ("Stuff Input" . te-stuff-string)
  106.       ("Flush Pending Output" . te-flush-pending-output)
  107.       ("Enable More Processing" . te-enable-more-processing)
  108.       ("Disable More Processing" . te-disable-more-processing)
  109.       ("Scroll at end of page" . te-do-scrolling)
  110.       ("Wrap at end of page" . te-do-wrapping)
  111.       ("Switch To Buffer" . switch-to-buffer)
  112.       ("Other Window" . other-window)
  113.       ("Kill Buffer" . kill-buffer)
  114.       ("Help" . te-escape-help)
  115.       ("Set Redisplay Interval" . te-set-redisplay-interval)
  116.       )))
  117.  
  118. ;(setq terminal-more-break-map nil)
  119. (if terminal-more-break-map
  120.     nil
  121.   (let ((map (make-keymap)))
  122.     (fillarray map 'te-more-break-unread)
  123.     (define-key map (char-to-string help-char) 'te-more-break-help)
  124.     (define-key map " " 'te-more-break-resume)
  125.     (define-key map "\C-l" 'redraw-display)
  126.     (define-key map "\C-o" 'te-more-break-flush-pending-output)
  127.     ;;>>> this isn't right
  128.     ;(define-key map "\^?" 'te-more-break-flush-pending-output) ;DEL
  129.     (define-key map "\r" 'te-more-break-advance-one-line)
  130.  
  131.     (setq terminal-more-break-map map)))
  132.   
  133.  
  134. ;;;;  escape map
  135.  
  136. (defun te-escape ()
  137.   (interactive)
  138.   (let (s 
  139.     (local (current-local-map))
  140.     (global (current-global-map)))
  141.     (unwind-protect
  142.     (progn
  143.       (use-global-map terminal-escape-map)
  144.       (use-local-map terminal-escape-map)
  145.       (setq s (read-key-sequence
  146.             (if prefix-arg
  147.             (format "Emacs Terminal escape> %d "
  148.                 (prefix-numeric-value prefix-arg))
  149.                 "Emacs Terminal escape> "))))
  150.       (use-global-map global)
  151.       (use-local-map local))
  152.     (message "")
  153.     (cond ((string= s (make-string 1 terminal-escape-char))
  154.        (setq last-command-char terminal-escape-char)
  155.        (let ((terminal-escape-char -259))
  156.          (te-pass-through)))
  157.       ((setq s (lookup-key terminal-escape-map s))
  158.        (call-interactively s)))))
  159.  
  160. (defun te-escape-help ()
  161.   "Provide help on commands available after terminal-escape-char is typed."
  162.   (interactive)
  163.   (message "Terminal emulator escape help...")
  164.   (let ((char (single-key-description terminal-escape-char)))
  165.     (with-electric-help
  166.       (function (lambda ()
  167.      (princ (format "Terminal-emulator escape, invoked by \"%s\"
  168. Type \"%s\" twice to send a single \"%s\" through.
  169.  
  170. Other chars following \"%s\" are interpreted as follows:\n"
  171.             char char char char))
  172.  
  173.      (princ (substitute-command-keys "\\{terminal-escape-map}\n"))
  174.      (princ (format "\nSubcommands of \"%s\" (%s)\n"
  175.             (where-is-internal 'te-escape-extended-command
  176.                        terminal-escape-map t)
  177.             'te-escape-extended-command))
  178.      (let ((l (if (fboundp 'sortcar)
  179.               (sortcar (copy-sequence te-escape-command-alist)
  180.                    'string<)
  181.               (sort (copy-sequence te-escape-command-alist)
  182.                 (function (lambda (a b)
  183.                               (string< (car a) (car b))))))))
  184.        (while l
  185.          (let ((doc (or (documentation (cdr (car l)))
  186.                 "Not documented")))
  187.            (if (string-match "\n" doc)
  188.            ;; just use first line of documentation
  189.            (setq doc (substring doc 0 (match-beginning 0))))
  190.            (princ "  \"")
  191.            (princ (car (car l)))
  192.            (princ "\":\n     ")
  193.            (princ doc)
  194.            (write-char ?\n))
  195.          (setq l (cdr l))))
  196.      nil)))))
  197.  
  198.             
  199.  
  200. (defun te-escape-extended-command ()
  201.   (interactive)
  202.   (let ((c (let ((completion-ignore-case t))
  203.          (completing-read "terminal command: "
  204.                   te-escape-command-alist
  205.                   nil t))))
  206.     (if c
  207.     (catch 'foo
  208.       (setq c (downcase c))
  209.       (let ((l te-escape-command-alist))
  210.         (while l
  211.           (if (string= c (downcase (car (car l))))
  212.           (throw 'foo (call-interactively (cdr (car l))))
  213.         (setq l (cdr l)))))))))
  214.  
  215. ;; not used.
  216. (defun te-escape-extended-command-unread ()
  217.   (interactive)
  218.   (setq unread-command-char last-input-char)
  219.   (te-escape-extended-command))
  220.  
  221. (defun te-set-escape-char (c)
  222.   "Change the terminal-emulator escape character."
  223.   (interactive "cSet escape character to: ")
  224.   (let ((o terminal-escape-char))
  225.     (message (if (= o c)
  226.          "\"%s\" is escape char"
  227.              "\"%s\" is now escape; \"%s\" passes though")
  228.          (single-key-description c)
  229.          (single-key-description o))
  230.     (setq terminal-escape-char c)))
  231.  
  232.  
  233. (defun te-stuff-string (string)
  234.   "Read a string to send to through the terminal emulator
  235. as though that string had been typed on the keyboard.
  236.  
  237. Very poor man's file transfer protocol."
  238.   (interactive "sStuff string: ")
  239.